home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_100 / 117_01 / copy.ftn < prev    next >
Text File  |  1985-03-09  |  12KB  |  375 lines
  1. C
  2. C COPY - COPY STANDARD INPUT TO STANDARD OUTPUT
  3.       INTEGER C, GETCH, DUMMY
  4. C
  5. 10    CONTINUE
  6. C                       10003 INDICATES AN EOF
  7.       IF (GETCH(C,DUMMY) .EQ. 10003)  GO TO 25
  8.       CALL PUTCH (C, DUMMY)
  9.       GO TO 10
  10. C
  11. 25    CONTINUE
  12. C
  13. C                      ALSO TEST REMARK
  14.       CALL REMARK (17HEND OF COPY TEST.)
  15.       CALL EXIT
  16.       END
  17. C
  18. C GETCH - GET CHARACTERS FROM FILE
  19. C
  20.        INTEGER FUNCTION GETCH(C, F)
  21.        INTEGER INMAP
  22.        INTEGER BUF(81), C
  23.        INTEGER F, I, LASTC
  24.        DATA LASTC /81/, BUF(81) /10/
  25. C
  26. C                      10 IS THE NEWLINE CHARACTER
  27.        IF(.NOT.(BUF(LASTC) .EQ. 10 .OR. LASTC .GE. 81))   GOTO 23114
  28. C                  CHANGE THE UNIT NUMBER IF NECESSARY
  29.        READ(5, 1, END=10) (BUF(I), I = 1, 80)
  30. 1      FORMAT(80 A1)
  31.        CONTINUE
  32.        I = 1
  33. 23116  IF(.NOT.( I .LE. 80))   GOTO 23118
  34.        BUF(I) = INMAP(BUF(I))
  35. 23117   I = I + 1
  36.        GOTO 23116
  37. 23118  CONTINUE
  38.        CONTINUE
  39.        I = 80
  40. 23119  IF(.NOT.( I .GT. 0)) GOTO 23121
  41. C                           32 IS BLANK
  42.        IF(.NOT.(BUF(I) .NE. 32))  GOTO 23122
  43.        GOTO 23121
  44. 23122  CONTINUE
  45. 23120   I = I - 1
  46.        GOTO 23119
  47. 23121  CONTINUE
  48. C                 10 IS NEWLINE
  49.        BUF(I+1) = 10
  50.        LASTC = 0
  51. 23114  CONTINUE
  52.        LASTC = LASTC + 1
  53.        C = BUF(LASTC)
  54.        GETCH = C
  55.        RETURN
  56. C          10003 IS END-OF-FILE MARKER
  57. 10     C = 10003
  58.        GETCH = 10003
  59.        RETURN
  60.        END
  61. C
  62. C PUTCH (INTERIM VERSION)  PUT CHARACTERS
  63. C
  64.        SUBROUTINE PUTCH(C, F)
  65.        INTEGER BUF(81), C
  66.        INTEGER OUTMAP
  67.        INTEGER F, I, LASTC
  68.        DATA LASTC /0/
  69. C
  70. C                        10 IS THE NEWLINE CHARACTER
  71.        IF(.NOT.(LASTC .GE. 81 .OR. C .EQ. 10))   GOTO 23342
  72.        IF(.NOT.( LASTC .LE. 0 ))  GOTO 23344
  73. C                 IF NECESSARY, CHANGE THE UNIT NUMBER IS THE
  74. C                 2 WRITE STATEMENTS IN THIS ROUTINE AND THE
  75. C                 1 IN REMARK
  76.        WRITE(6,2)
  77. 2      FORMAT(/)
  78.        GOTO 23345
  79. 23344  CONTINUE
  80.        WRITE(6, 1) (BUF(I), I = 1, LASTC)
  81. 1      FORMAT(80 A1)
  82. 23345  CONTINUE
  83.        LASTC = 0
  84. 23342  CONTINUE
  85. C                      10 IS NEWLINE
  86.        IF(.NOT.(C .NE. 10)) GOTO 23346
  87.        LASTC = LASTC + 1
  88.        BUF(LASTC) = OUTMAP(C)
  89. 23346  CONTINUE
  90.        RETURN
  91.        END
  92. C
  93. C REMARK - INTERIM VERSION
  94. C
  95.        SUBROUTINE REMARK(BUF)
  96.        INTEGER BUF(100), I
  97. C            DON'T WORRY ABOUT FINDING THE END OF THE BUF
  98. C            ARRAY JUST YET.  SIMPLY PRINT OUT 20 OR SO
  99. C            CHARACTERS IN WHATEVER FORMAT YOUR SYSTEM
  100. C            NEEDS FOR PRINTING HOLLERITH ARRAYS.
  101. C
  102. C                 YOU MIGHT HAVE THE CHANGE THE UNIT NUMBER
  103.        WRITE(6, 10) (BUF(I), I = 1, 10)
  104. 10     FORMAT(10A2)
  105.        RETURN
  106.        END
  107. C
  108. C INMAP - CONVERT LEFT ADJUSTED EXTERNAL REP TO RIGHT ADJ ASCII
  109. C
  110.        INTEGER FUNCTION INMAP(INCHAR)
  111.        INTEGER I, INCHAR
  112.        COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
  113.      *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
  114.        INTEGER EXTDIG
  115.        INTEGER INTDIG
  116.        INTEGER EXTLET
  117.        INTEGER INTLET
  118.        INTEGER EXTBIG
  119.        INTEGER INTBIG
  120.        INTEGER EXTCHR
  121.        INTEGER INTCHR
  122.        INTEGER EXTBLK
  123.        INTEGER INTBLK
  124. C
  125. C                IS IT A BLANK?
  126.        IF(.NOT.(INCHAR .EQ. EXTBLK)) GOTO 23194
  127.        INMAP = INTBLK
  128.        RETURN
  129. 23194  CONTINUE
  130.        DO23196I = 1, 10
  131. C                IS IT A DIGIT?
  132.        IF(.NOT.(INCHAR .EQ. EXTDIG(I))) GOTO 23198
  133.        INMAP = INTDIG(I)
  134.        RETURN
  135. 23198  CONTINUE
  136. 23196  CONTINUE
  137. 23197  CONTINUE
  138. C                 IS IT A SMALL LETTER?
  139.        DO23200I = 1, 26
  140.        IF(.NOT.(INCHAR .EQ. EXTLET(I))) GOTO 23202
  141.        INMAP = INTLET(I)
  142.        RETURN
  143. 23202  CONTINUE
  144. 23200  CONTINUE
  145. 23201  CONTINUE
  146. C                 IS IT A CAPITAL LETTER?
  147.        DO23204I = 1, 26
  148.        IF(.NOT.(INCHAR .EQ. EXTBIG(I))) GOTO 23206
  149.        INMAP = INTBIG(I)
  150.        RETURN
  151. 23206  CONTINUE
  152. 23204  CONTINUE
  153. 23205  CONTINUE
  154. C               IS IT A SPECIAL CHARACTER?
  155.        DO23208I = 1, 33
  156.        IF(.NOT.(INCHAR .EQ. EXTCHR(I))) GOTO 23210
  157.        INMAP = INTCHR(I)
  158.        RETURN
  159. 23210  CONTINUE
  160. 23208  CONTINUE
  161. 23209  CONTINUE
  162. C               MUST BE SOMETHING ELSE
  163.        INMAP = INCHAR
  164.        RETURN
  165.        END
  166. C
  167. C
  168. C OUTMAP - CONVERT RIGHT ADJ ASCII TO LEFT ADJUSTED EXTERNAL REP
  169. C
  170.        INTEGER FUNCTION OUTMAP(INCHAR)
  171.        INTEGER I, INCHAR
  172.        COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
  173.      *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
  174.        INTEGER EXTDIG
  175.        INTEGER INTDIG
  176.        INTEGER EXTLET
  177.        INTEGER INTLET
  178.        INTEGER EXTBIG
  179.        INTEGER INTBIG
  180.        INTEGER EXTCHR
  181.        INTEGER INTCHR
  182.        INTEGER EXTBLK
  183.        INTEGER INTBLK
  184. C
  185. C               IS IT A BLANK?
  186.        IF(.NOT.(INCHAR .EQ. INTBLK)) GOTO 23270
  187.        OUTMAP = EXTBLK
  188.        RETURN
  189. 23270  CONTINUE
  190. C               IS IT A DIGIT?
  191.        DO23272I = 1, 10
  192.        IF(.NOT.(INCHAR .EQ. INTDIG(I))) GOTO 23274
  193.        OUTMAP = EXTDIG(I)
  194.        RETURN
  195. 23274  CONTINUE
  196. 23272  CONTINUE
  197. 23273  CONTINUE
  198. C                IS IT A SMALL LETTER?
  199.        DO23276I = 1, 26
  200.        IF(.NOT.(INCHAR .EQ. INTLET(I))) GOTO 23278
  201.        OUTMAP = EXTLET(I)
  202.        RETURN
  203. 23278  CONTINUE
  204. 23276  CONTINUE
  205. 23277  CONTINUE
  206. C                   IS IT A CAPITAL LETTER?
  207.        DO23280I = 1, 26
  208.        IF(.NOT.(INCHAR .EQ. INTBIG(I))) GOTO 23282
  209.        OUTMAP = EXTBIG(I)
  210.        RETURN
  211. 23282  CONTINUE
  212. 23280  CONTINUE
  213. 23281  CONTINUE
  214. C                    IS IT A SPECIAL CHARACTER?
  215.        DO23284I = 1, 33
  216.        IF(.NOT.(INCHAR .EQ. INTCHR(I))) GOTO 23286
  217.        OUTMAP = EXTCHR(I)
  218.        RETURN
  219. 23286  CONTINUE
  220. 23284  CONTINUE
  221. 23285  CONTINUE
  222. C                 MUST BE SOMETHING ELSE
  223.        OUTMAP = INCHAR
  224.        RETURN
  225.        END
  226.  
  227. C
  228. C BLOCK DATA - INITIALIZE GLOBAL VARIABLES
  229. C
  230.        BLOCK DATA
  231.        COMMON /CCHAR/ EXTDIG(10), INTDIG(10), EXTLET(26), INTLET(26),  E
  232.      *XTBIG(26), INTBIG(26), EXTCHR(33), INTCHR(33),  EXTBLK, INTBLK
  233.        INTEGER EXTDIG
  234.        INTEGER INTDIG
  235.        INTEGER EXTLET
  236.        INTEGER INTLET
  237.        INTEGER EXTBIG
  238.        INTEGER INTBIG
  239.        INTEGER EXTCHR
  240.        INTEGER INTCHR
  241.        INTEGER EXTBLK
  242.        INTEGER INTBLK
  243.        DATA EXTBLK /1H /, INTBLK /32/
  244.        DATA EXTDIG(1) /1H0/, INTDIG(1) /48/
  245.        DATA EXTDIG(2) /1H1/, INTDIG(2) /49/
  246.        DATA EXTDIG(3) /1H2/, INTDIG(3) /50/
  247.        DATA EXTDIG(4) /1H3/, INTDIG(4) /51/
  248.        DATA EXTDIG(5) /1H4/, INTDIG(5) /52/
  249.        DATA EXTDIG(6) /1H5/, INTDIG(6) /53/
  250.        DATA EXTDIG(7) /1H6/, INTDIG(7) /54/
  251.        DATA EXTDIG(8) /1H7/, INTDIG(8) /55/
  252.        DATA EXTDIG(9) /1H8/, INTDIG(9) /56/
  253.        DATA EXTDIG(10) /1H9/, INTDIG(10) /57/
  254.        DATA EXTLET(1) /1Ha/, INTLET(1) /97/
  255.        DATA EXTLET(2) /1Hb/, INTLET(2) /98/
  256.        DATA EXTLET(3) /1Hc/, INTLET(3) /99/
  257.        DATA EXTLET(4) /1Hd/, INTLET(4) /100/
  258.        DATA EXTLET(5) /1He/, INTLET(5) /101/
  259.        DATA EXTLET(6) /1Hf/, INTLET(6) /102/
  260.        DATA EXTLET(7) /1Hg/, INTLET(7) /103/
  261.        DATA EXTLET(8) /1Hh/, INTLET(8) /104/
  262.        DATA EXTLET(9) /1Hi/, INTLET(9) /105/
  263.        DATA EXTLET(10) /1Hj/, INTLET(10) /106/
  264.        DATA EXTLET(11) /1Hk/, INTLET(11) /107/
  265.        DATA EXTLET(12) /1Hl/, INTLET(12) /108/
  266.        DATA EXTLET(13) /1Hm/, INTLET(13) /109/
  267.        DATA EXTLET(14) /1Hn/, INTLET(14) /110/
  268.        DATA EXTLET(15) /1Ho/, INTLET(15) /111/
  269.        DATA EXTLET(16) /1Hp/, INTLET(16) /112/
  270.        DATA EXTLET(17) /1Hq/, INTLET(17) /113/
  271.        DATA EXTLET(18) /1Hr/, INTLET(18) /114/
  272.        DATA EXTLET(19) /1Hs/, INTLET(19) /115/
  273.        DATA EXTLET(20) /1Ht/, INTLET(20) /116/
  274.        DATA EXTLET(21) /1Hu/, INTLET(21) /117/
  275.        DATA EXTLET(22) /1Hv/, INTLET(22) /118/
  276.        DATA EXTLET(23) /1Hw/, INTLET(23) /119/
  277.        DATA EXTLET(24) /1Hx/, INTLET(24) /120/
  278.        DATA EXTLET(25) /1Hy/, INTLET(25) /121/
  279.        DATA EXTLET(26) /1Hz/, INTLET(26) /122/
  280.        DAT